Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d12/v9n21.arc/PRISM.INC

Text File | 1990-11-17 | 57KB | 1,703 lines

{ ========================================================================= }
{ PRISM.INC                                                                 }
{ ========================================================================= }
{ NoVga =================================================================== }

PROCEDURE NoVga;

BEGIN
  WryteLn (ProgramName + ' is capable of setting each of the 16 attributes');
  WryteLn ('of the VGA text mode display to any of 262,144 different colors.');
  WryteLn ('It requires a computer with a VGA card and a compatible monitor.');
  WryteLn ('');
  textcolor (colormono (lightred, white));
  WryteLn ('Sorry.  This system is not running a VGA display.');
  halt;
END;

{ NoBw ==================================================================== }

PROCEDURE NoBw;

BEGIN
  WryteLn (ProgramName + ' is capable of setting each of the 16 attributes');
  WryteLn ('of the VGA text mode display to any of 262,144 different colors.');
  WryteLn ('');
  textcolor (colormono (lightred, white));
  WryteLn ('Sorry.  It cannot be run in monochrome mode.');
  halt;
END;

{ VgaRegisterOb.Accept ==================================================== }

PROCEDURE VgaRegisterOb.Accept (Num, Rval, Gval, Bval : byte);

BEGIN
  With ColorValues do begin
    ColorNumber := Num;
    EgaReg := EgaPal [ColorNumber];
    R := Rval;
    G := Gval;
    B := Bval;

    Saturation := 63 - min (R, min (G, B));      { saturation }
    Intensity := max (R, max (G, B));            { intensity }

    Rreal := R;
    Greal := G;
    Breal := B;
    end;
END;

{ VgaRegisterOb.Get ======================================================= }

PROCEDURE VgaRegisterOb.Get (Color : byte);

BEGIN
  With ColorValues do begin
    ColorNumber := Color;
    EgaReg := EgaPal [ColorNumber];
    GetVgaRegister (EgaReg, R, G, B);

    Saturation := 63 - min (R, min (G, B));      { saturation }
    Intensity := max (R, max (G, B));            { intensity }

    Rreal := R;
    Greal := G;
    Breal := B;
    end;
END;

{ VgaRegisterOb.GetSaturation ============================================= }

PROCEDURE VgaRegisterOb.GetSaturation (Color : byte);

BEGIN
  With ColorValues do begin
    Get (Color);
    if Saturation > 0 then begin
      Rstep := (63 - R)/Saturation;              { step size }
      Gstep := (63 - G)/Saturation;
      Bstep := (63 - B)/Saturation;
      end
    else begin
      Rstep := 1;                                { step size }
      Gstep := 1;
      Bstep := 1;
      end;
    end;
END;

{ VgaRegisterOb.GetIntensity ============================================== }

PROCEDURE VgaRegisterOb.GetIntensity (Color : byte);

BEGIN
  With ColorValues do begin
    Get (Color);
    if Intensity > 0 then begin
      Rstep := R/Intensity;                      { step size }
      Gstep := G/Intensity;
      Bstep := B/Intensity;
      end
    else begin
      Rstep := 1;                                { step size }
      Gstep := 1;
      Bstep := 1;
      end;
    end;
END;

{ VgaRegisterOb.Put ======================================================= }

PROCEDURE VgaRegisterOb.Put;

BEGIN
  With ColorValues do begin
    R := round (Rreal);
    G := round (Greal);
    B := round (Breal);
    Saturation := 63 - min (R, min (G, B));      { saturation }
    Intensity := max (R, max (G, B));            { intensity }
    SetVgaRegister (EgaReg, R, G, B);
    end;
END;

{ VgaRegisterOb.SetSaturation ============================================= }

PROCEDURE VgaRegisterOb.SetSaturation (Vector : integer);

BEGIN
  With ColorValues do begin
    repeat
      Rreal := Rreal + Rstep * Vector;
      Greal := Greal + Gstep * Vector;
      Breal := Breal + Bstep * Vector;
    until
      (round (Rreal) <> R) or (round (Greal) <> G) or (round (Breal) <> B);
    Put;
    end;
END;

{ VgaRegisterOb.SetIntensity ============================================== }

PROCEDURE VgaRegisterOb.SetIntensity (Vector : integer);

BEGIN
  With ColorValues do begin
    repeat
      Rreal := Rreal + Rstep * Vector;
      Greal := Greal + Gstep * Vector;
      Breal := Breal + Bstep * Vector;
    until
      (round (Rreal) <> R) or (round (Greal) <> G) or (round (Breal) <> B);
    Put;
    end;
END;

{ ========================================================================= }
{ VgaPaletteOb.Init ======================================================= }

PROCEDURE VgaPaletteOb.Init;
VAR Loop : byte;
BEGIN

  Get;                                           { P = current palette }
  MaxYank := 15;                                 { how many to store }
  Ctr := 0;
  for Loop := 0 to MaxYank do                    { fill stack with P }
    Stack [Loop] := StoreVgaPal;

END;

{ VgaPaletteOb.Push ======================================================= }

PROCEDURE VgaPaletteOb.Push;
{ Store deleted palette on stack }

BEGIN
  { if current palette is not most recently stored palette ... }
  if
    CompStruct (Stack [Ctr], P, sizeof (VgaRegArray)) <> equal
  then begin
    UpCycle (Ctr, 0, MaxYank);                   { increment counter }
    Stack [Ctr] := P;                            { store on top of stack }
    end;
END;

{ VgaPaletteOb.Pop ======================================================== }

PROCEDURE VgaPaletteOb.Pop (VAR Palette : VgaRegArray);
{ Retrieve deleted palette from stack }

VAR
  Loop : byte;

BEGIN
  Loop := 0;
  While
    (CompStruct (Stack [Ctr], P, sizeof (VgaRegArray)) = equal)
      and
    (Loop <= MaxYank)
  do begin
    DownCycle (Ctr, 0, MaxYank);
    inc (Loop);
    end;

  Palette := Stack [Ctr];                        { pop most recent palette }
  Stack [Ctr] := P;                              { store P at new bottom }
  DownCycle (Ctr, 0, MaxYank);                   { decrement counter }
END;

{ VgaPaletteOb.Get ======================================================== }

PROCEDURE VgaPaletteOb.Get;
BEGIN
  GetVgaPalette (P);
END;

{ VgaPaletteOb.Put ======================================================== }

PROCEDURE VgaPaletteOb.Put;
BEGIN
  SetVgaPalette (P);                             { P is the new palette }
  Push;                                          { push it onto stack }
END;

{ VgaPaletteOb.Swap ======================================================= }

PROCEDURE VgaPaletteOb.Swap (Source, Target : byte);
VAR
  Loop : byte;
  SwapPal : VgaRegArray;
BEGIN
  SwapPal := P;
  for Loop := 1 to 3 do begin
    P [Source, Loop] :=
      SwapPal [Target, Loop];
    P [Target, Loop ] :=
      SwapPal [Source, Loop];
    end;  { loop }
  Put;
END;

{ VgaPaletteOb.Dupe ======================================================= }

PROCEDURE VgaPaletteOb.Dupe (Source, Target : byte);
VAR
  Loop : byte;
BEGIN
  for Loop := 1 to 3 do
    P [Target, Loop] := P [Source, Loop];
  Put;
END;

{ VgaPaletteOb.SetRGB ===================================================== }

PROCEDURE VgaPaletteOb.SetRGB (ColorNumber, Color, Value : byte);

BEGIN

  P [ColorNumber, Color] := Value;
  SetVgaRegister (EgaPal [ColorNumber],
                  P [ColorNumber, 1],
                  P [ColorNumber, 2],
                  P [ColorNumber, 3]);

END;

{ VgaPaletteOb.DissolveTo ================================================= }

PROCEDURE VgaPaletteOb.DissolveTo (NewPal : VgaRegArray);
{ change to a new palette }

BEGIN
  Dissolve (P, NewPal);                          { go from current to new }
  P := NewPal;                                   { new is now current }
  Push;                                          { store it on stack }
END;

{ ========================================================================= }
{ ResetDefaults =========================================================== }

PROCEDURE ResetDefaults;

BEGIN
{
  If no Config file, then clone the EXE file.
}
  if not ExistAnyFile (ConfigFileName) then
    if CloneArranger.InitCustom (ExeFileName, UpdateAll, DefBufSize) then begin
      if CloneArranger.FindDefaultsEnd (Id, SizeOf (Id), 0) then begin

        { write new values }
        CloneArranger.StoreDefaults (CloneArranger.GetPos,
                                     Id,
                                     Ofs (CfgEnd) - Ofs (Id));
        { check for errors }
        if CloneArranger.GetLastError = 0 then begin
          CloneArranger.Done;                    { close the EXE file }
          exit;
          end;
        end;

      { Oops, can't clone the EXE file. }
      CloneArranger.Done;                        { close the EXE file }
      end;

{
  Can't clone EXE file, so write to ConfigFile.
}
  Rewrite (ConfigFile, sizeof (Block));          { write to config file }
  BlockWrite (ConfigFile, Block, 1);
  Close (ConfigFile);
END;

{ SliderSound ============================================================= }

PROCEDURE SliderSound;
VAR
  S          : string;
  Loop       : byte;
BEGIN
  if not Sfx (SfxCues) then exit;
  FastRead (80, SliderOption + SaturationLine, 1, S);
  Case SliderOption of
    0    : Loop := Pos (SaturationChar, S);
    1..3 : Loop := Pos (SliderChar, S);
    4    : Loop := Pos (IntensityChar, S);
    end;
  sound (Loop * 100);
END;

{ SliderBeep ============================================================== }

PROCEDURE SliderBeep;
VAR
  Loop : byte;
BEGIN
  if not Sfx (SfxCues) then exit;
  SliderSound;
  delay (3);
  Loop := 0;
  repeat
    inc (Loop)
  until
    (Loop = 50)
      or
    KeyOrButtonPressed;
  nosound;
END;

{ DrawAttributeBox ======================================================== }

PROCEDURE DrawAttributeBox (ColorNumber : byte);
CONST
  S : string [10] = ' ' +
                    BxChar + BxChar + BxChar + BxChar +
                    BxChar + BxChar + BxChar + BxChar + ' ';

VAR
  Loop : byte;
BEGIN
  for Loop := 1 to 4 do
    FastWrite (S,                                               { string }
               trunc (1 + ((ColorNumber div 8) * 5)) + Loop,    { row }
               succ ((ColorNumber mod 8) * 10),                 { column }
               ColorNumber);                                    { attr }
END;

{ QuickStr ================================================================ }

FUNCTION QuickStr (V : byte) : string;           { formatted num to str }
BEGIN
  Write (TpStr, V:2);
  QuickStr := ReturnStr;
END;

{ QuickMark =============================================================== }

FUNCTION QuickMark (M : string;  V : byte;  S : char) : string;
VAR
  MeterString : string [70];
  Mark : string [3];

BEGIN
  Mark := ^A + S + ^A;
  MeterString := M;                              { string with mark }
  Insert (Mark, MeterString, V + 2);
  QuickMark := MeterString;
END;

{ ShowKernel ============================================================== }

PROCEDURE ShowKernel (Vgr : VgaRegisterOb);
{ Writes stars and bars. }
CONST
  Fattrs : FlexAttrs = (Black, White, Green, Blue);
VAR
  Loop   : byte;

BEGIN
  if (CurrentColor = Black) or (CurrentColor = White) then
    Fattrs [0] := LightGray
  else
    Fattrs [0] := CurrentColor;

  HideMouse;
  With Vgr, ColorValues do begin
    MeterString2 [1] := #201;                              { top }
    MeterString2 [65] := #187;
    FlexWrite (QuickMark (MeterString2, Saturation, SaturationChar),
               SaturationLine, 12, Fattrs);

    FlexWrite (QuickMark (MeterString1, R, SliderChar),
               RedLine, 12, Fattrs);                       { red }
    FlexWrite (QuickMark (MeterString1, G, SliderChar),
               GreenLine, 12, Fattrs);                     { green }
    FlexWrite (QuickMark (MeterString1, B, SliderChar),
               BlueLine, 12, Fattrs);                      { blue }

    { show actual number values }
    For Loop := 0 to 4 do
      FastWrite (QuickStr (ValArray [Loop]),
                 SaturationLine + Loop, 79, White);

    MeterString2 [1] := #200;                              { bottom }
    MeterString2 [65] := #188;
    FlexWrite (QuickMark (MeterString2, Intensity, IntensityChar),
               IntensityLine, 12, Fattrs);
    end;
  ShowMouse;
END;

{ ShowPercentages ========================================================= }

PROCEDURE ShowPercentages (ColorNum : byte);
{ Shows percentages of particular color. }
VAR
  Vgr : VgaRegisterOb;

BEGIN
  With Pal do
    Vgr.Accept (ColorNum, P [ColorNum, 1], P [ColorNum, 2], P [ColorNum, 3]);
  ShowKernel (Vgr);
END;

{ SlidePercentages ======================================================== }

{$F+} PROCEDURE SlidePercentages; {$F-}
{ Shows percentage of CurrentColor.  Slides during dissolves. }

VAR
  Vgr : VgaRegisterOb;

BEGIN
  Vgr.Get (CurrentColor);
  ShowKernel (Vgr);
END;

{ DrawBox ================================================================= }

PROCEDURE DrawBox;
CONST
  BoxTop         : string [11] = #201#205#205#205#205#205#205#205#205#187;
  BoxSide        : string [4]  = #186#186#186#186;
  BoxBottom      : string [11] = #200#205#205#205#205#205#205#205#205#188;
  EmptyBoxTop    : string [11] = '          ';
  EmptyBoxSide   : string [4]  = '    ';

VAR
  TopRow   : byte;
  LeftCol  : byte;
  Top, Side, Bottom : string [11];
  BoxColor : byte;

BEGIN
  { outline box is blank }
  Top := EmptyBoxTop;
  Side := EmptyBoxSide;
  Bottom := EmptyBoxTop;
  TopRow := trunc (1 + ((LastColor div 8) * 5));
  LeftCol := succ ((LastColor mod 8) * 10);

  { erase old outline box }
  if CurrentColor <> LastColor then begin
    FastWrite (Top, TopRow, LeftCol, Black);
    inc (TopRow);
    FastVert (Side, TopRow, LeftCol, Black);
    FastVert (Side, TopRow, LeftCol + 9, Black);
    FastWrite (Bottom, TopRow + 4, LeftCol, Black);
    end;

  { outline box is frame }
  Top := BoxTop;
  Side := BoxSide;
  Bottom := BoxBottom;
  TopRow := trunc (1 + ((CurrentColor div 8) * 5));
  LeftCol := succ ((CurrentColor mod 8) * 10);
  if Pending.Status > -1 then                              { color of box }
    BoxColor := LightRed
  else
    BoxColor := White;

  { draw new outline box }
  FastWrite (Top, TopRow, LeftCol, BoxColor);              { draw box }
  inc (TopRow);
  FastVert (Side, TopRow, LeftCol, BoxColor);
  FastVert (Side, TopRow, LeftCol + 9, BoxColor);
  FastWrite (Bottom, TopRow + 4, LeftCol, BoxColor);

  LastColor := CurrentColor;
END;

{ ShowSelectedColor ======================================================= }

PROCEDURE ShowSelectedColor;
VAR
  Loop : integer;
  StoreMouseCursor : boolean;
BEGIN

  HideMousePrim (StoreMouseCursor);
  for Loop := 1 to 5 do
    FastWrite (CharStr (BxChar, 38), 11 + Loop, 22, CurrentColor);
  DrawBox;
  ShowPercentages (CurrentColor);
  ShowMousePrim (StoreMouseCursor);

END;

{ ShowSliderOption ======================================================== }

PROCEDURE ShowSliderOption;
VAR
  LocalColor : byte;
  StoreMouseCursor : boolean;

BEGIN
  if Pending.Status > -1 then exit;              { uh oh, operation pending }
  if SliderOption = LastSliderOption then exit;  { no need to change option }

  HideMousePrim (StoreMouseCursor);
  FastWrite ('  Saturate ', SaturationLine, 1, White);
  FastWrite ('       Red ',        RedLine, 1, White);
  FastWrite ('     Green ',      GreenLine, 1, White);
  FastWrite ('      Blue ',       BlueLine, 1, White);
  FastWrite (' Intensity ',  IntensityLine, 1, White);
  ChangeAttribute (11,
                   SaturationLine + SliderOption, 1,
                   BlackOnLtGray + 128);
  ShowMousePrim (StoreMouseCursor);
  LastSliderOption := SliderOption;
END;

{ SetSlider =============================================================== }

PROCEDURE SetSlider (CurrentColor, SliderOption, NewVal : integer);
{ shell for SetVgaRegister. }
VAR
  Vector  : integer;

BEGIN
  if Pending.Status > -1 then exit;              { uh oh, operation pending }

  NewVal := min (max (NewVal, 0), 63);           { check range }
  With VgaReg, ColorValues do
    case SliderOption of
      0    : begin
             While
               (Saturation <> NewVal)
             do begin
               if Saturation > NewVal then Vector := 1 else Vector := -1;
               SetSaturation (Vector);
               end;
             Pal.Get;
             ShowPercentages (CurrentColor);
             end;
      1..3 : With Pal do begin
               SetRGB (CurrentColor,
                       SliderOption,
                       round (MinReal (MaxReal (NewVal, 0), 63)));
               ShowPercentages (CurrentColor);
               end;
      4    : begin
             While
               (Intensity <> NewVal)
             do begin
               if Intensity < NewVal then Vector := 1 else Vector := -1;
               SetIntensity (Vector);
               end;
             Pal.Get;
             ShowPercentages (CurrentColor);
             end;
      end;  { case }
END;

{ GoBack ================================================================== }

PROCEDURE GoBack;
VAR
  P : VgaRegArray;
BEGIN

  if Pending.Status > -1 then                    { if operation pending }
    Pending.Erase                                { then cancel it }
  else begin                                     { else }

    Pal.Pop (P);                                 { pop last palette }
    Pal.DissolveTo (P);                          { and dissolve to it }
    end;
END;

{ RandomPalette =========================================================== }

PROCEDURE RandomPalette;
VAR
  Loop, Color : byte;
  NewPal     : VgaRegArray;

BEGIN
  NewPal := Pal.P;
  for Loop := 0 to 15 do
    for Color := 1 to 3 do
      NewPal [Loop, succ (random (3))] := random (10) * 7;
  Pal.DissolveTo (NewPal);
END;

{ HandleIsDevice ========================================================== }

FUNCTION HandleIsDevice (H : word) : boolean;
VAR
  R : registers;
BEGIN
  HandleIsDevice := false;
  with R do begin
    AH := $44;                                   { IOCTL }
    AL := $00;                                   { subfunction 0 }
    BX := H;
    MsDos (R);
    if not Odd (Flags) then
      HandleIsDevice := DX and $80 <> 0;
    end;
END;

{ GetUserFileName ========================================================= }

CONST
GetFileNameFlag : boolean = false;

PROCEDURE GetUserFileName (VAR S : string);
VAR
  Len     : byte absolute S;
  Le      : LineEditor;                          { line editor object }

  Loop    : byte;
  F       : file;
  Created : boolean;

BEGIN
  GetFileNameFlag := true;
  Le.Init (MenuColors);
  EditCommands.cpOptionsOn (cpEnableMouse);         { turn mouse on }
  EditCommands.AddCommand (ccQuit, 1, KcCtrlU, 0);  { exit on Ctrl-U }

  S := '';                                       { S = null string }
  While S = '' do begin                          { while no valid file name }

    Created := false;
    Le.ReadString (' Palette Name? ',
                   14, 29, 8, 8, S);             { read S }
    Case Le.GetLastCommand of
      ccQuit : S := '';                          { cancel name }
      end;

    if
      (S = '')                                   { if no name }
    then begin                                   { exit without name }
      Le.Done;
      ShowSelectedColor;
      GetFileNameFlag := false;
      exit;
      end;

    S := StUpCase (S);                           { upcase S }

    Assign (F, S);                               { assign file name }
    {$I-} Reset (F); {$I+}                       { open it }
    if IOresult <> 0 then begin                  { IO error }
      {$I-} Rewrite (F);  {$I+}
      if IOresult <> 0 then begin                { IO error }
        { failed to create file }
        end
      else begin                                 { file created }
        { created the file }
        Created := true;
        end;
      end

    else begin                                   { file already exists }
      end;

    if FileRec (F).mode = fmClosed then begin    { file is closed }
      end
    else begin
      if HandleIsDevice (FileRec(F).Handle) then begin
        PauseMsgBox ('Sorry, DOS will not allow ''' + S +
                     ''' to be used as a palette file name.  ' +
                     'Please enter another name.',
                     ReddbColorSet, dbJustify + dbShadow, 40);
        S := '';                                 { cancel S, try again }
        end;
      Close (F);                                 { close file }
      if Created then erase (F);                 { if created, erase file }
      end;

    For Loop := 1 to Len do
      if S [Loop] = ' ' then S [Loop] := '_';    { translate spaces }
    end;                                         { while S = '' do begin }

  Le.Done;
  ShowSelectedColor;
  GetFileNameFlag := false;
END;

{ WritePalette ============================================================ }

PROCEDURE WritePalette;
VAR
  Pfile     : file of VgaRegArray;
  PfileName : string;
  PfileAttr : word;

BEGIN
  PaletteFileName := JustName (PaletteFileName);

  if
    (PaletteFileName = '')
      or
    ((PaletteFileName > '')
      and
    (not YornBox ('Store as ''' + PaletteFileName + ''' palette?  (Y/N)')))
  then
    GetUserFileName (PaletteFileName);

  if PaletteFileName = '' then exit;             { escape if no file name }
  PfileName := ProgramPath + ForceExtension (PaletteFileName, 'PAL');

  if
    not ExistFile (PFileName)
      or
    (ExistFile (PFileName)
      and
    YornBox ('The ''' + PaletteFileName +
             ''' palette already exists as a file.  Overwrite?  (Y/N)'))
  then begin
    Assign (Pfile, PFileName);
    GetFattr (Pfile, PfileAttr);
    if PfileAttr and ReadOnly = ReadOnly then
      PauseMsgBox ('Sorry.  The ''' + PaletteFileName +
                   ''' palette has been stored as a read-only file.' +
                   '  It cannot be overwritten.',
                   RedDbColorSet, dbJustify + dbShadow, 40)
    else begin
      Rewrite (Pfile);
      Write (Pfile, Pal.P);
      Close (Pfile);
      TimedPauseMsg ('The ''' + PaletteFileName + ''' palette has been saved.',
                        GreenDbColorSet, dbShadow, 60, 1500);
      end;
    end;
END;

{ ReadDiskPalette ========================================================= }

PROCEDURE ReadDiskPalette;
{ Read palette from disk file . }

VAR
  Pfile     : file of VgaRegArray;
  PfileAttr : word;
  NewPal    : VgaRegArray;

BEGIN
  PaletteFileName := PickFile;
  if PaletteFileName > '' then begin

    Assign (Pfile, PaletteFileName);
    GetFattr (PFile, PfileAttr);
    if PfileAttr and ReadOnly = ReadOnly then
      SetFattr (PFile, 0);                       { workaround Turbo quirk }
    Assign (Pfile, PaletteFileName);
    Reset (Pfile);
    Read (Pfile, NewPal);
    Close (Pfile);
    SetFattr (Pfile, PfileAttr);

    Pal.DissolveTo (NewPal);
    end;
END;

{ LoadNewPalette ========================================================== }

PROCEDURE LoadNewPalette;
{ Load a palette from disk without running editor. }

VAR
  Pfile     : file of VgaRegArray;
  PfileAttr : word;
  NewPal    : VgaRegArray;
  Pname     : string [12];

BEGIN
  Pal.Get;                                       { get active palette }
  Wryte (ProgramName);

  Pname := ForceExtension (StUpCase (ParamStr (1)), 'PAL');
  PaletteFileName := ProgramPath + Pname;
  if not ExistAnyFile (PaletteFileName) then begin
    WryteLn (' cannot locate ''' + Pname + '''');
    exit;
    end;

  WryteLn (' loading ' + PaletteFileName);

  Assign (Pfile, PaletteFileName);
  GetFattr (PFile, PfileAttr);
  if PfileAttr and ReadOnly = ReadOnly then
    SetFattr (PFile, 0);                         { workaround Turbo quirk }
  Assign (Pfile, PaletteFileName);
  Reset (Pfile);
  Read (Pfile, NewPal);
  Close (Pfile);
  SetFattr (Pfile, PfileAttr);
  Pal.DissolveTo (NewPal);                       { dissolve to new palette }
END;

{ ========================================================================= }
{ MouseEventDeclarations ================================================== }

CONST
  MouseEventReentryFlag : boolean = false;
  RightButtonFlag       : boolean = false;
  RandomPaletteFlag     : boolean = false;

VAR
  TempStack : array [1..4096] of byte;           { temporary stack }

{ UserHook ================================================================ }

{$F+}
PROCEDURE UserHook (CPP : CommandProcessorPtr;
                    MT  : MatchType;
                    Key : word);
{$F-}
BEGIN
{
  Can't do a dissolve inside the mouse event handler.  It screws things up.
  Instead, look to see if the flag is set;  if it is, do the dissolve here.
}
  if not RandomPaletteFlag then exit;
  RandomPaletteFlag := false;
  RandomPalette;
END;

{ MouseEventKernel ======================================================== }

{$F+} PROCEDURE MouseEventKernel (Var Dummy : IntRegisters); {$F-}
{
  This procedure contains the real work of the mouse event handler.
}

CONST
  MinCol = 13;
  MaxCol = 76;
  WindowRestricted : boolean = false;

VAR
  CharAtMouseCursor : char;                      { what char under mouse }
  AttrAtMouseCursor : byte;                      { what attr under mouse }

{ ------------------------- }

PROCEDURE BoxCharClicked;
BEGIN
  { if mouse was clicked on any of 16 little boxes... }
  if MouseLastY < 11 then begin
    if CurrentColor <> AttrAtMouseCursor then begin
      CueClick;
      CurrentColor := AttrAtMouseCursor;         { change active color }

      { If flag set then swap color with current color }
      if Pending.Status > -1 then begin          { if operation pending }
        Pal.Swap (SelectColor, CurrentColor);
        Pending.Erase;                           { zap pending box }
        end;
      ShowSelectedColor;
      end;
    end

  { User has clicked on large current color box in center of the screen. }
  else begin
    CueClick;
    { get ready for a swap, dupe, or random palette }
    if (TimeMs - MouseStoreTime) < 333 then begin
      Pending.Erase;
      { Can't do a dissolve inside the event handler, it interferes
        with the mouse, so set a flag instead and trigger it in
        the UserHook procedure. }
      RandomPaletteFlag := true;
      end
    else begin
      MouseStoreTime := TimeMs;
      Pending.Draw;                              { operation pending }
      SelectColor := CurrentColor;
      end;
    end;
END;

{ ------------------------- }

  PROCEDURE EndSliders;
  BEGIN
    { end slider move, restore mouse window }
    if not WindowRestricted then exit;

    FullMouseWindow;
    WindowRestricted := false;
    { restore mouse cursor shape }
    With MenuColors do
      SoftMouseCursor($0000, (ColorMono (MouseColor, MouseMono) shl 8) +
                              Byte (MouseChar));
    ShowMouse;
    Pal.Push;                                    { store it on pal stack }
  END;

{ ------------------------- }

  PROCEDURE DoLeftButtonReleased;
  BEGIN
{
  If the Pending msg is active, then a color operation is pending.
  Left button down sends msg that color duplication is pending,
  left button up means color swap is pending.
}
    if Pending.Status > -1 then begin            { if operation pending }
      Pending.SetStatus (succ (ord (MouseStatus = LeftButton)));
{
  If mouse has been dragged to target color box, then
  duplicate the current color into the target color.
}
      if
        (CharAtMouseCursor = BxChar) and         { if target color box }
        (MouseLastY < 11)
      then begin
        CueClick;
        CurrentColor := AttrAtMouseCursor;       { get current color }
        Pal.Dupe (SelectColor, CurrentColor);    { duplicate }
        Pending.Erase;                           { zap pending msg }
        ShowSelectedColor;                       { update screen }
        end;
      end
    else
      EndSliders;                                { if WindowRestricted }
  END;

{ ------------------------- }

  PROCEDURE DoMouseMoved;
  BEGIN

{ If the Pending window is open then a color operation is pending.
  Left button down sends msg that color duplication is pending,
  left button up means color swap is pending.  }

    if Pending.Status > -1 then begin
      if CharAtMouseCursor = BxChar then
        Pending.SetStatus (succ (ord (MouseStatus = LeftButton)))
      else begin
        Case Pending.Status of
          0, 2 : Pending.SetStatus (succ (ord (MouseStatus = LeftButton)));
          end;  { case}
        end;
      end

{ Any other mouse move would be a slider.  If user is not
  pressing the left button, then end all slider operations now. }

    else
      if MouseStatus <> LeftButton then
        EndSliders

{ If the left button is down and the window is restricted, then
  user is dragging a slider.  If he's not dragging a slider, then
  he clicked while moving the mouse. }

      else
        if WindowRestricted then begin           { drag a slider }
          SliderSound;
          delay (3);
          HideMouse;
          SetSlider (CurrentColor, SliderOption, MouseLastX - 1);
          ShowMouse;
          NoSound;
          end;
  END;

{ ------------------------- }

  PROCEDURE DoLeftButtonPressed;
  BEGIN
    if
      (MouseLastY >= SaturationLine)             { if mouse in slider frame }
        and
      (MouseLastY <= IntensityLine)
    then begin                                   { then set sliders }
      SliderOption := MouseLastY - SaturationLine;
      ShowSliderOption;
      CueClick;
      end;

    case CharAtMouseCursor of
      BxChar       : BoxCharClicked;

      SliderChar,
      LineChar     : begin
                     Pending.Erase;
                     { force window around mouse }
                     MouseWindow (MinCol, SaturationLine + SliderOption,
                                  MaxCol, SaturationLine + SliderOption);
                     WindowRestricted := true;
                     SliderSound;
                     { change Mouse cursor shape }
                     With MenuColors do
                       SoftMouseCursor($0000,
                         (ColorMono (MouseColor, MouseMono) shl 8) +
                           Byte (SliderChar));
                     { update the slider }
                     HideMouse;
                     SetSlider (CurrentColor, SliderOption, MouseLastX - 13);
                     ShowMouse;
                     nosound;
                     end;

      SaturationChar,
      IntensityChar,
      FrameChar    : begin
                     Pending.Erase;
                     if (MouseLastY = SaturationLine) or
                        (MouseLastY = IntensityLine)
                     then
                       With VgaReg, ColorValues do begin
                         Case SliderOption of
                           0 : begin
                               GetSaturation (CurrentColor);
                               With MenuColors do
                                 SoftMouseCursor ($0000,
                                   (ColorMono (MouseColor, MouseMono) shl 8)
                                     + Byte (SaturationChar));
                               end;
                           4 : begin
                               GetIntensity (CurrentColor);
                               With MenuColors do
                                 SoftMouseCursor ($0000,
                                   (ColorMono (MouseColor, MouseMono) shl 8)
                                     + Byte (IntensityChar));
                               end;
                           end; { case }

                         if
                           (SliderOption = 0)
                             or
                           (SliderOption = 4)
                         then begin
                           { force window around mouse }
                           MouseWindow (MinCol,
                                        SaturationLine + SliderOption,
                                        MaxCol,
                                        SaturationLine + SliderOption);
                           WindowRestricted := true;
                           SliderSound;
                           { update the slider }
                           HideMouse;
                           SetSlider
                             (CurrentColor, SliderOption, MouseLastX - 13);
                           ShowMouse;
                           nosound;
                           end;
                         end;  { with VgaReg, ColorValues do begin }
                     end;  { begin }
      end; { case }
  END;

{ ------------------------- }

BEGIN;
  { If right button is pressed, do not allow left button events. }
  if MouseEvent and RightButtonReleased <> 0 then
    RightButtonFlag := false;
  if MouseEvent and RightButtonPressed <> 0 then
    RightButtonFlag := true;
  if RightButtonFlag then exit;

  GotoxyAbs (MouseLastX, MouseLastY);            { send cursor to mouse }
  HideMouse;                                     { no mouse }
  ReadAtCursor
    (CharAtMouseCursor, AttrAtMouseCursor);      { read screen }
  ShowMouse;                                     { return mouse }

  Case MouseEvent of
    MouseMoved + LeftButtonReleased,
    LeftButtonReleased               : DoLeftButtonReleased;
    MouseMoved + LeftButtonPressed,
    LeftButtonPressed                : DoLeftButtonPressed;
    MouseMoved                       : DoMouseMoved;
    end;  { case }
END;

{ MouseEventHandler ======================================================= }

{$F+} PROCEDURE MouseEventHandler; {$F-}

VAR
  Dummy : IntRegisters;

BEGIN;
  if M.ActiveSubPtr <> nil then                  { if submenus are active }
    exit;                                        { don't do anything }
  if PrismHelp.IsActive then exit;               { if help window open }
  if GetFileNameFlag then exit;                  { if getting a file name }

  if MouseEventReentryFlag then exit;            { don't enter here twice }
  MouseEventReentryFlag := true;                 { set reentry flag }

  SwapStackAndCall (@MouseEventKernel,
                    @TempStack [sizeof (TempStack)],
                    Dummy);                      { get real event handler }

  MouseEventReentryFlag := false;                { reset reentry flag }
END;

{ ========================================================================= }
{ SetMouseSpeed =========================================================== }

PROCEDURE SetMouseSpeed (NewSpeed : byte);
BEGIN
  Case NewSpeed of
    0 : SetMickeyToPixelRatio (16, 32);
    1 : SetMickeyToPixelRatio (8, 16);
    2 : SetMickeyToPixelRatio (4, 8);
    3 : SetMickeyToPixelRatio (2, 4);
    end; { case }
  MouseSpeed := NewSpeed;
  { save new default }
END;

{ PostInstructions ======================================================== }

PROCEDURE PostInstructions;
VAR
  Left, Right : byte;
CONST
  LocalColor : byte = LightGray;

BEGIN
  if MouseInstalled then begin
    Left := 3;  Right := 63;
    FastWrite ('Click on square', 13, Left, LocalColor);
    FastWrite ('to change the',   14, Left, LocalColor);
    FastWrite ('active color.',   15, Left, LocalColor);
    FastWrite ('Click on slider', 13, Right, LocalColor);
    FastWrite ('and hue options', 14, Right, LocalColor);
    FastWrite ('to alter shade. ', 15, Right, LocalColor);
    end
  else begin
    Left := 1;  Right := 63;
    FastWrite ('Use Ctrl-Left-Arrow', 13, Left, LocalColor);
    FastWrite ('or Ctrl-Right-Arrow', 14, Left, LocalColor);
    FastWrite ('to select a color.', 15, Left, LocalColor);
    FastWrite ('Use Shift-Arrows', 13, Right, LocalColor);
    FastWrite ('to move sliders ',  14, Right, LocalColor);
    FastWrite ('and hue options.', 15, Right, LocalColor);
    end;
END;

{ ShowMainScreen ========================================================== }

{$F+} PROCEDURE ShowMainScreen; {$F-}
VAR
  Loop : byte;

BEGIN
  MouseStoreTime := TimeMs;                      { mouse click time delay }

  SetBlink (false);                              { no blinking }
  ClrScr;
  for Loop := 0 to 15 do
    DrawAttributeBox (Loop);                     { draw attribute boxes }

  PostInstructions;                              { normal instructions }
  ShowSelectedColor;                             { current color }
  ShowSliderOption;                              { which slider }

{ Menu Initializations ---------------------------------------------------- }

  Status := InitMenu (M);
  if Status <> 0 then begin
    WriteLn('Error initializing menu: ', Status);
    Halt(1);
  end;

  Status := InitHelpLine (H);
  if Status <> 0 then begin
    WriteLn('Error initializing help line: ', Status);
    Halt(1);
  end;
  M.SetCurrentItemProc (UpdateHelpLine);

  H.Draw;                                        { draw help }
  M.Draw;                                        { draw menu }

  if MouseInstalled then
    with MenuColors do begin
      DisableEventHandling;                      { no mouse events yet }

      {activate mouse cursor}
      SoftMouseCursor($0000, (ColorMono (MouseColor, MouseMono) shl 8)+
                             Byte (MouseChar));
      ShowMouse;
      { enable mouse support }
      MenuCommands.cpOptionsOn (cpEnableMouse);
      SetMouseSpeed (MouseSpeed);
      MouseGotoxy (80, 25);                      { go to your corner }
      KeyStateByte := 0;
      end
  else begin
    M.ProtectItem (miMouse3);                    { no mouse help }
    M.ProtectItem (miMouse11);                   { no mouse speed reset }
    KeyStateByte := NumLock;                     { turn editing keys on }
    end;

  CW.InitCustom  (23, 13, 58, 15, MenuColors, wClear + wBordered);
  CW.SetCursor (CuHidden);
  CW.Draw;
  CW.wFastCenter (ProgramName, 1, WhiteOnCyan);
  CW.wFastCenter ('a VGA palette editor', 2, BlackOnCyan);
  CW.wFastCenter ('by David Gerrold', 3, BlackOnCyan);

END;

{ ========================================================================= }
{ PendOb.Init ============================================================= }

PROCEDURE PendOb.Init;
BEGIN
  Status := -1;
END;

{ PendOb.Draw ============================================================= }

PROCEDURE PendOb.Draw;
VAR
  Left, Right : byte;
BEGIN
  Status := 0;
  DrawBox;

  Left := 1;  Right := 62;
  FastWrite (PadCenter ('Color', 18),          13, Left, LightRed);
  FastWrite (PadCenter ('Operation', 18),      14, Left, LightRed);
  FastWrite (PadCenter ('Pending', 18),        15, Left, LightRed);
  FastWrite (PadCenter ('Click to swap ', 16),  13, Right, LightRed);
  FastWrite (PadCenter ('Drag to dupe  ', 16),   14, Right, LightRed);
  FastWrite (PadCenter ('Undo to cancel', 16), 15, Right, LightRed);
END;

{ PendOb.SetStatus ======================================================== }

PROCEDURE PendOb.SetStatus (NewStatus : integer);
CONST
  StatusMsg : array [1 .. 2] of string [12] =
              ('Swap ',
               'Duplication');
VAR
  Left : byte;
BEGIN
  if Status < 0 then exit;
  if Status = NewStatus then exit;

  Status := NewStatus;
  Left := 1;
  FastWrite (PadCenter (StatusMsg [NewStatus], 18), 14, Left, LightRed);
END;

{ PendOb.Erase ============================================================ }

PROCEDURE PendOb.Erase;
BEGIN
  PostInstructions;
  Status := -1;
END;

{ ========================================================================= }
{ EndProc ================================================================= }

{$F+}
PROCEDURE EndProc;
BEGIN
  PrismHelp.Done;                                { no more help object }
  H.Done;                                        { end help }
  M.Done;                                        { end menu }
END;
{$F-}

{ ========================================================================= }
{ RunEditor =============================================================== }

PROCEDURE RunEditor;
VAR
  SliderFlag : boolean;                          { for ccUser4 & ccuser6 }
  StoreTime  : longint;

CONST
  LastccUser : byte = 0;                         { last cursorpad char }

BEGIN
  Pal.Init;                                      { start palette }
  Pending.Init;                                  { initialize pending box }

  LastColor    := 0;
  CurrentColor := succ (Random (15));            { pick a color }
  LastSliderOption := 4;
  SliderOption := 0;                             { which slider }

{ Menu Initializations ---------------------------------------------------- }

  MenuCommands.SetUserHookProc (UserHook);

  MenuCommands.AddCommand (ccQuit, 1, KcCtrlU, 0);

  MenuCommands.AddCommand (ccUser2, 1, KcNumpad2, 0);
  MenuCommands.AddCommand (ccUser4, 1, KcNumpad4, 0);
  MenuCommands.AddCommand (ccUser6, 1, KcNumpad6, 0);
  MenuCommands.AddCommand (ccUser8, 1, KcNumpad8, 0);
  MenuCommands.AddCommand (ccUser10, 1, KcCtrlD, 0);
  MenuCommands.AddCommand (ccUser11, 1, KcCtrlN, 0);
  MenuCommands.AddCommand (ccUser12, 1, KcCtrlR, 0);
  MenuCommands.AddCommand (ccUser13, 1, KcCtrlS, 0);

  MenuCommands.AddCommand (ccUser15, 1, KcCtrlLeftArrow, 0);
  MenuCommands.AddCommand (ccUser16, 1, KcCtrlRightArrow, 0);
  MenuCommands.AddCommand (ccUser17, 1, KcNumPadDot, 0);
  MenuCommands.AddCommand (ccUser18, 1, KcCtrlHomeKey, 0);

  MenuCommands.AddCommand (ccUser20, 1, MouseBoth, 0);

  Status := MenuCommands.GetLastError;
  if Status <> 0 then begin
    WryteLn ('Failed to add commands.  Error: ' + Num2Str (Status));
    halt;
    end;

{ Help Initialization ----------------------------------------------------- }

  { Make a help window with custom options }
  if not PrismHelp.InitMemCustom (9, 8, 72, 18,
                                 MenuColors,
                                 wBordered,
                                 @HelpText,
                                 PickVertical)
  then begin
    WryteLn ('Failed to initialize Help System.');
    halt;
    end;

  { Add some features }
  PrismHelp.EnableExplosions (6);
  PrismHelp.wFrame.AddHeader (' Topic Index ', heTC);
  PrismHelp.AddMoreHeader (' || for more ', heBR, #24, #25, '', 2, 3, 0);
  PrismHelp.AddTopicHeader (1, 60, heTC);
  PrismHelp.AddMoreHelpHeader (
    ' PgUp/PgDn for more ', heBR, 'PgUp', 'PgDn', '/', 2, 7, 6);

  PrismHelp.wFrame.AddShadow (shBr, shSeeThru);
  PrismHelp.hwFrame.AddShadow (shBr, shSeeThru);

  if SfxFlag then
    PrismHelp.wOptionsOn (wSoundEffects);
  HelpCommands.cpOptionsOn (cpEnableMouse);      { Add mouse support }

{ Fade out Dos, Fade in Program ------------------------------------------- }

  FadeStart (ShowMainScreen, co80);              { put up display }
  DissolveProc := SlidePercentages;
  SetMouseEventHandler (AllMouseEvents,
                        @MouseEventHandler);
  EnableEventHandling;

{
  Certain processes need to occur within the ShowMainScreen procedure
  because they need to happen after the DOS screen fades out, but before
  the program screen fades in.  In particular, H.Draw and M.Draw, which
  draw the help line and menu on the screen.

  Mouse event handling must be disabled during fade in and fade out of
  program, because a mouse event may trigger a crash during the dissolve
  process.
}
{ Run program ------------------------------------------------------------- }

  StoreTime := TimeMs;                           { get time }
  repeat
    if StoreTime > TimeMs then                   { allow for midnight }
      StoreTime := TimeMs;
  until                                          { wait until }
    KeyOrButtonPressed or                        { key event }
    ((TimeMs - StoreTime) > 3000);               { or 3 seconds }
  CW.done;                                       { erase colophon }
  ShowSelectedColor;                             { show correct color }

  ExitFlag := false;
  repeat
    M.Process;
    if M.GetLastCommand = ccSelect then begin
      case M.MenuChoice of
        miKeypad2       : GetHelp (miKeypad2);
        miMouse3        : GetHelp (miMouse3);
        miAbout4        : GetHelp (miAbout4);
        miAbout5        : GetHelp (miAbout5);
        miUsing6        : GetHelp (miUsing6);
        miReferences7   : GetHelp (miReferences7);
        miCopyright8    : GetHelp (miCopyright8);
        miSound10       : begin
                          CueClick;
                          SfxFlag := not SfxFlag;
                          if SfxFlag then
                            PrismHelp.wOptionsOn (wSoundEffects)
                          else
                            PrismHelp.wOptionsOff (wSoundEffects);
                          SfxOptions := byte (SfxFlag);
                          end;
        miMouse11       : begin
                          CueClick;
                          UpCycle (MouseSpeed, 0, 3);
                          SetMouseSpeed (MouseSpeed);
                          end;
        miDissolve12    : begin
                          CueClick;
                          UpCycle (DissolveDelay, 0, 6);
                          FadeRate := FadeRateArray [DissolveDelay];
                          end;
        miUndo14        : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          GoBack;
                          end;
        miSwap15        : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          if
                            (Pending.Status = 1) and
                            (CurrentColor <> SelectColor)
                          then begin
                            Pending.Erase;
                            Pal.Swap (SelectColor, CurrentColor);
                            ShowPercentages (CurrentColor);
                            end
                          else begin
                            Pending.Draw;
                            Pending.SetStatus (1);
                            SelectColor := CurrentColor;
                            end;
                          end;
        miRestore16     : begin;
                          CueClick;
                          M.EraseCurrentSubMenu;
                          Pal.DissolveTo (StoreVgaPal);
                          end;
        miNew17         : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          RandomPalette;
                          end;
        miDuplicate18   : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          if
                            (Pending.Status = 2) and
                            (CurrentColor <> SelectColor)
                          then begin
                            Pending.Erase;
                            Pal.Dupe (SelectColor, CurrentColor);
                            ShowPercentages (CurrentColor);
                            end
                          else begin
                            Pending.Draw;
                            Pending.SetStatus (2);
                            SelectColor := CurrentColor;
                            end;
                          end;
        miLoad19        : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          ReadDiskPalette;
                          end;
        miSave20        : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          WritePalette;
                          end;
        miYesExit22     : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          DissolveProc := zen;
                          ExitFlag := true;
                          end;
        miNoResume23    : begin
                          CueClick;
                          M.EraseCurrentSubMenu;
                          end;
        end;  { case }
      end
    else

      if M.ActiveSubPtr <> nil then begin        { if active submenu }
        case M.GetLastCommand of
          { Esc, MouseRt, Ctrl-U }
          ccQuit : begin                         { if Quit }
                   M.EraseCurrentSubMenu;        { erase submenu }
                   CueClick;                     { make noise }
                   end;
          end;  { case }
        end

      else begin                                 { if no active submenus }
                                                 { edit the palette }
{
  If the last command was a slider change the the current command
  is not a slider change, then Push the current palette onto the undo
  stack so it can be restored.
}
        if
          not SliderFlag and
          (M.GetLastCommand <> ccUser4) and (M.GetLastCommand <> ccUser6)
        then
          Pal.Push;

{
  Case statement for processing user commands.
}
        case M.GetLastCommand of

          { Undo:  Esc, ^U or Mouse right button }
          ccQuit          : begin
                            CueClick;            { make noise first }
                            if Pending.Status > -1 then
                              Pending.Erase      { cancel pending operation }
                            else                 { or }
                              GoBack;            { restore previous palette }
                            end;

          { NumPad 2 }
          ccUser2         : begin
                            UpCycle (SliderOption, 0, 4);
                            ShowSliderOption;
                            CueClick;
                            end;

          { NumPad 4, 6 }
          ccUser4,
          ccUser6         : With VgaReg, ColorValues do begin
                            SliderFlag := (LastccUser <> ccUser4) and
                                          (LastccUser <> ccUser6);
                            Case SliderOption of
                              0    : if SliderFlag then
                                       GetSaturation (CurrentColor);
                              1..3 : Get (CurrentColor);
                              4    : if SliderFlag then
                                        GetIntensity (CurrentColor);
                              end;  { case }
                            if
                              ((SliderOption > 0) and (SliderOption < 4))
                                or
                              not (SliderFlag
                                and
                              (((SliderOption = 0) and (Saturation = 0))
                                or
                              ((SliderOption = 4) and (Intensity = 0))))
                            then begin
                              { update the slider }
                              Case M.GetLastCommand of
                                ccUser4 : SetSlider
                                            (CurrentColor, SliderOption,
                                               ValArray [SliderOption] - 1);
                                ccUser6 : SetSlider
                                            (CurrentColor, SliderOption,
                                               ValArray [SliderOption] + 1);
                                end;  { case }
                              SliderBeep;
                              end;
                            end;

          { NumPad 8 }
          ccUser8         : begin
                            DownCycle (SliderOption, 0, 4);
                            ShowSliderOption;
                            CueClick;
                            end;
          { ^D for duplicate }
          ccUser10        : begin
                            CueClick;
                            if
                              (Pending.Status = 2) and
                              (CurrentColor <> SelectColor)
                            then begin
                              Pending.Erase;
                              Pal.Dupe (SelectColor, CurrentColor);
                              ShowPercentages (CurrentColor);
                              end
                            else begin
                              Pending.Draw;
                              Pending.SetStatus (2);
                              SelectColor := CurrentColor;
                              end;
                            end;

          { 'N' for new }
          ccUser11        : begin
                            CueClick;
                            RandomPalette;
                            end;

          { 'R', or MouseBoth for restore }
          ccUser12,
          ccUser20        : begin
                            CueClick;
                            Pending.Erase;
                            RightButtonFlag := false;
                            Pal.DissolveTo (StoreVgaPal);
                            end;

          { 'S' for swap }
          ccUser13        : begin
                            CueClick;
                            if
                              (Pending.Status = 1) and
                              (CurrentColor <> SelectColor)
                            then begin
                              Pending.Erase;
                              Pal.Swap (SelectColor, CurrentColor);
                              ShowPercentages (CurrentColor);
                              end
                            else begin
                              Pending.Draw;
                              Pending.SetStatus (1);
                              SelectColor := CurrentColor;
                              end;
                            end;

          { Ctrl Left Arrow }
          ccUser15        : begin
                            DownCycle (CurrentColor, 0, 15);
                            ShowSelectedColor;
                            CueClick;
                            end;

          { Ctrl Right Arrow }
          ccUser16        : begin
                            UpCycle   (CurrentColor, 0, 15);
                            ShowSelectedColor;
                            CueClick;
                            end;

          { Ctrl Home }
          ccUser18        : begin;
                            if CurrentColor > 7 then
                              CurrentColor := CurrentColor - 8
                            else
                              CurrentColor := CurrentColor + 8;
                            ShowSelectedColor;
                            CueClick;
                            end;

          end;  { case }

        LastccUser := M.GetLastCommand;
        end;  { begin }
  until
    ExitFlag;

  DisableEventHandling;                          { no mousing allowed }
  FinalFadeOutProc := EndProc;                   { dispose objects }

  if                                             { if any defaults changed }
    (StoreSfxFlag <> SfxFlag) or
    (StoreMouseSpeed <> MouseSpeed) or
    (StoreDissolveDelay <> DissolveDelay)
  then
    ResetDefaults;                               { reset default settings }
END;

{ ========================================================================= }
{ ========================================================================= }